COMMENT ⊗   VALID 00020 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002		TITLE	GCREF - MULTI FILE CREF LISTINGS
C00005 00003	GET THE COMMAND LINE AND PUT INTO THE COMMAND BUFFER
C00009 00004	 PROCESS A SWITCH IF / IS BREAK CHARACTER
C00012 00005	 NOW WE HAVE FINISHED SCANNING COMMAND LINE
C00014 00006	 FIND CORRECT PAGE OF FILE
C00017 00007	 HAVING FOUND CORRECT PAGE, SCAN IT AND BUILD DATA STRUCTURE
C00020 00008	 KEEP ON BUILDING STRUCTURE
C00023 00009	 END OF STRUCTURE BUILDING - NOW WE OUTPUT IT
C00025 00010	 RECURSIVE OUTPUT ROUTINE
C00029 00011	 GET ONE PART OF FILE SPECS
C00031 00012	 MAGIC DECIMAL CONVERSION ROUTINE 
C00033 00013	 STRING EQUALITY TEST
C00035 00014	 CREATE A NEW IDENTIFIER BLOCK
C00037 00015	 THIS IS THE MAGIC 6-STATE, TABLE DRIVEN, INPUT PARSER
C00040 00016	 MORE BRANCHES FOR INPUT SCANNER
C00042 00017	 STILL MORE BRANCHES
C00043 00018	 PRIMARY TABLE FOR INPUT SCANNER
C00045 00019	 MORE SECONDARY TABLES
C00047 00020	 FINISH WITH SOME VARIABLES
C00049 ENDMK
C⊗;
	TITLE	GCREF - MULTI FILE CREF LISTINGS
EXTERNAL JOBREL,JOBFF

P←17
PT←16;		CURRENT LINK POINTER
ST←15;		STATE
FR←14;		FREE STORAGE POINTER
CONV←13;	ARGUMENT FOR CONVRT
TA←12;		T AND TA MUST BE CONSECUTIVE
T←11
NEW←10;		POINTER TO NEW BLOCK
INP←7;		INPUT POINTER
NBUF←4;		# OF I/O BUFFERS
PLEN←40;	LENGTH OF STACK

;FIRST WE INITIALIZE THE WORLD EVERYTIME WE START A NEW COMMAND

	SKIPE SVJOB
	JRST [	MOVE SVJOB		;THIS CORE IMAGE ALREADY RAN
		MOVEM JOBFF		;RESTORE JOBFF
		JRST GCREF]
	MOVE JOBFF			;OTHERWISE,
	MOVEM SVJOB#			;SAVE JOBFF FOR INITIALIZATION
GCREF:	MOVE P,[IOWD PLEN,PDL]		;INIT STACK
	SETZM SHORT			;INIT FLAGS - SHORT LISTING
	SETZM GLBAL			;	GLOBALS ONLY
	SETZM LOCAL			;	LOCALS ONLY
	SETZM OUTPNT			;INIT POINTERS - DEFAULT OUTPUT FILE
	SETZM INPNT			;	START OF INPUT FILES
	HRRZ FR,JOBFF			;	START OF FREE STORAGE-1
	SETZM STRUCT			;	START OF DATA STRUCTURE
	SETZM DEFPPN
	HRLZI 'CRF'
	MOVEM DEFEXT
	SETZM ERROR			; ERROR FLAG
	MOVE 1,JOBREL			; START WITH 1K OF FREE CORE
	ADDI 1,2000
	CALLI 1,11
	JRST NOCORE
	INIT 1,				; OPEN DISK
	SIXBIT .DSK.
	XWD OBUF,IBUF
	JRST [ OUTSTR [ASCIZ . NO DISK.]
	       CALLI 12]
	OUTSTR CRLF
	OUTCHR ["*"]			;TELL HIM WE ARE READY
;GET THE COMMAND LINE AND PUT INTO THE COMMAND BUFFER

COMGET:	MOVE 1,COMPNT			; READ LINE INTO COMMAND BUFFER
	INCHWL 2
	IDPB 2,1
	CAIE 2,15			; UNTIL CARRIAGE RETURN
	JRST .-3
	SETZM 2				;CONVERT TO ASCIZ
	IDPB 2,1
	CLRBFI				;FLUSH LINE FEED FROM BUFFER

; SCAN COMMAND LINE FOR FILE NAME OR SWITCH
	
	MOVE 1,COMPNT
	SETZM 4
GETFIL:	SETZM NAME
	SETZM PT			;  NO NAME YET
	MOVE 2,[POINT 7,NAME]		;  GET NEXT FILE SPECS
	PUSHJ P,GETPAR			;	LOOK FOR FILE NAME
	SKIPN SNAM
	JRST ENDPPN			;       IF NONE, MAYBE SWITCH
	PUSH FR,SNAM
	MOVEI PT,(FR)
	CAIE 4,"."
	JRST [PUSH FR,DEFEXT		;	NO EXTENSION GIVEN
	      JRST ENDEXT]
	IDPB 4,2
	PUSHJ P,GETPAR			;   	LOOK FOR EXTENSION
	PUSH FR,SNAM
	MOVE SNAM
	TRNE 777777
	JRST SPCERR			;	EXTENSION TOO LONG
	MOVEM DEFEXT			;	NEW DEFAULT
ENDEXT:	PUSH FR,[0]			;	THIS IS A LOOKUP BLOCK
	CAIE 4,"["
	JRST [PUSH FR,DEFPPN		;	NO PPN GIVEN
	      JRST ENDPPN]
	IDPB 4,2
	PUSHJ P,GETPAR			;	GET PPN
	SKIPN 6,SNAM
	JRST SPCERR
	TLNN 6,77			;	RIGHT ADJUSTED
	JRST [LSH 6,-6
	      JRST .-1]
	PUSH FR,6
	HLLM 6,DEFPPN
	CAIE 4,","
	JRST SPCERR
	IDPB 4,2
	PUSHJ P,GETPAR			;	GET REST OF PPN
	SKIPN 6,SNAM
	JRST SPCERR
	TLNN 6,77			;	ALSO RIGHT ADJUSTED
	JRST [LSH 6,-6
	      JRST .-1]
	HLRM 6,(FR)
	HLRM 6,DEFPPN
	IDPB 4,2
	CAIN 4,"]"
	JRST [	ILDB 4,1		; GET NEXT BREAK CHARACTER
		JRST ENDPPN]
SPCERR:	OUTSTR CRLF
	OUTSTR [ASCIZ .ILLEGAL FILE SPECIFICATION .]
	OUTSTR NAME
IGLOUT:	OUTSTR CRLF
	JRST GCLOOP
; PROCESS A SWITCH IF / IS BREAK CHARACTER

ENDPPN:	CAIE 4,"/"			; SWITCH COMING UP
	JRST L2
	ILDB 4,1
	CAIN 4,"L"
	JRST [SETOM LOCAL		; OUTPUT ONLY LOCALS
	      JRST LAB1]
	CAIN 4,"S"
	JRST [SETOM SHORT		; SHORT LISTING REQUESTED
	      JRST LAB1]
	CAIN 4,"G"
	JRST [SETOM GLBAL		; OUTPUT ONLY GLOBALS
LAB1:	      ILDB 4,1			;GET A NEW BREAK CHAR TO DECODE
	      JRST ENDPPN]
	OUTSTR CRLF
	OUTSTR [ASCIZ .ILLEGAL SWITCH - .]
IGLCHR:	OUTCHR 4
	JRST IGLOUT

; STORE FILE NAME FOR INPUT OR OUTPUT, AS BREAK CHAR INDICATES

L2:	SKIPN PT			;ONLY IF WE HAVE A FILE NAME
	JRST GETFIL
	CAIE 4,"←"
	JRST L1
	SKIPN INPNT			;OUTPUT FILE - ERROR IF INPUT FILE
	SKIPE OUTPNT			; ALREADY EXISTS OR
	JRST IGLBRK			; ALREADY HAVE AN OUTPUT FILE
	MOVEM PT,OUTPNT			; OTHERWISE, STORE POINTER TO BLOCK
	JRST GETFIL	

; WE HAVE ANOTHER INPUT FILE TO STORE IN LIST

L1:	SKIPN INPNT			; INIT POINTER IF FIRST BLOCK
	MOVEM PT,INPNT			; NEW INPUT FILE SPEC FOUND
	PUSHJ P,LOOKFL			; MAKE SURE FILE EXISTS
	CLOSE 1,			; BUT THEN LET GO OF IT FOR NOW
	CAIN 4,","
	JRST GETFIL			; RETURN FOR NEXT FILE SPEC
	CAIN 4,"→"
	JRST	[OUTSTR CRLF
		OUTCHR ["→"]
		JRST COMGET]		; MULTI LINE COMMAND
	CAIN 4,15
	JRST ENDCOM			; END OF COMMAND SCANNING
IGLBRK:	OUTSTR CRLF
	OUTSTR [ASCIZ .ILLEGAL CHARACTER - .]
	JRST IGLCHR
; NOW WE HAVE FINISHED SCANNING COMMAND LINE
; LOOKUP EACH FILE 

ENDCOM:	PUSH FR,[0]			; TO STOP FILE LOOKUPS
	SKIPE INPNT
	SKIPE ERROR
	JRST COMGET			; NO INPUT FILES OR ERROR
	MOVE INPNT
	MOVEM NXTPNT#			; NEXT INPUT FILE
	MOVEI 1,(FR)			; SET UP IOWD FOR FREE POINTER
	SUB FR,JOBREL
	HRLI FR,(FR)
	HRRI FR,(1)
LOOP:	MOVE 1,NXTPNT			;START LOOP TO INPUT FILES
	SKIPN 2,(1)			; IF ZERO - END OF FILES
	JRST ENDFIL
	LOOKUP 1,(1)			; LOOKUP NEXT FILE
	HALT				; ALREADY CHECKED THIS
	MOVEI 4(1)			; UPDATE POINTER TO NEXT FILE
	MOVEM NXTPNT
	MOVEI BUFRS			; GET SOME BUFFERS
	MOVEM JOBFF
	INBUF 1,NBUF
	INPUT 1,			; AND SOME DATA
	MOVE 3,[POINT 7,NAME+1]		; CONVERT FILE NAME TO ASCIZ
	SETZM NAME
	SETZM 1
	LSHC 1,6
	JUMPE 1,.+5
	MOVEI 1,40(1)
	IDPB 1,3
	AOS NAME
	JRST .-6
	IDPB 1,3
	OUTSTR CRLF			; LET USER KNOW WE ARE WORKING
	OUTSTR NAME+1
P11:	MOVEI 1,=30*5			; GET FIRST LINE OF PAGE
	MOVE 2,COMPNT
P10:	PUSHJ P,GCHAR
	IDPB CONV,2
	CAIN CONV,12
	JRST P2
	CAIN CONV,14
	JRST P11
	SOJG 1,P10
	JRST TSTFAL			; LINE TOO LONG
P2:	SETZM ST			;SCAN LINE AND TEST IF RIGHT PAGE
	MOVE [ILDB CONV,INP]		; SET PARSER TO READ CURRENT LINE
	MOVEM GET
	SETZM SVBRK
	MOVE INP,COMPNT
	SETZM CCNT
; FIND CORRECT PAGE OF FILE

	SETZM FID
P1:	SETZM ID
	PUSHJ P,PARSE			; PARSE INPUT
	MOVE 1,ID			; GET COUNT
	MOVE 2,ID+1			; AND FIRST WORD OF IDENTIFIER
	CAIN 1,4
	JRST	[XOR 2,[ASCII .FAIL.]	; COUNT=4
		ANDCMI 2,17		; TEST FAILS IF ID='FAIL' OR 'SAIL'
		JUMPE 2,TSTFAL
		MOVE 2,ID+1
		XOR 2,[ASCII .SAIL.]
		ANDCMI 2,17
		JUMPE 2,TSTFAL
		JRST P1]
	CAIN 1,5
	JRST	[XOR 2,[ASCII .MACRO.]	; COUNT=5
		JUMPE 2,TSTFAL		; TEST FAILS IF ID='MACRO'
		JRST P1]
	CAIE 1,7
	JRST P1				; NOT A RECOGNIZED ID, SCAN FURTHER
	XOR 2,[ASCII .PROGR.]		; COUNT=7
	JUMPN 2,P1			; TEST FAILS IF ID='PROGRAM'
	MOVE 2,ID+2
	XOR 2,[ASCII .AM.]
	AND 2,[XWD 17,-1]
	JUMPN 2,P1
TSTFAL:	MOVEI ST,1			;NOT CORRECT PAGE
	MOVE P10
	MOVEM GET
	SETZM SVBRK
	PUSHJ P,PARSE			;SCAN TO NEXT PAGE
	JRST P11			; AND TEST IT

; DATA STRUCTURE IS AS FOLLOWS:
;	WORD 1	LH: POINTER TO LAST BLOCK - 0 IF FIRST BLOCK OF LIST
;		RH: POINTER TO NEXT BLOCK - 0 IF LAST BLOCK OF LIST
;	WORD 2	LH: POINTER TO FIRST BLOCK ON LOWER STRUCTURE (0 IF LOWEST
;			LEVEL)
;		RH: WORD COUNT FOR DATA
;	REST	DATA: IF IDENTIFIER, CHARACTER COUNT FOLLOWED BY ASCIZ
;			STRING; IF LINE NUMBERS, DIGITS
;			STORED TWO TO A WORD (0 IN UNUSED HALVES) AND
;			NEGATED IF THIS IS THE IDENTIFIER DEFINITION
;
;	TOP LEVEL ARE IDENTIFIERS USED IN PROGRAM
;	NEXT LEVEL, FOR EACH IDENTIFIER, IS THE NAMES OF THE FILES
;		CONTAINING THE IDENTIFIER
;	NEXT LEVEL, IF ANY, IS THE NAMES OF THE BLOCKS WITHIN WHICH THE
;		IDENTIFIER WAS DEFINED
;	BOTTOM LEVEL IS LIST OF LINE NUMBERS
; HAVING FOUND CORRECT PAGE, SCAN IT AND BUILD DATA STRUCTURE

TSTOK:	MOVE [ILDB CONV,INP]		;NOW WE HAVE THE CORRECT PAGE
	MOVEM GET			; SCAN FIRST LINE AGAIN
	MOVE INP,COMPNT
	SETZM LEV1			; NO ID ON LEVEL 1 YET
	PUSH P,[STRUCT]			; INIT LINK POINTER
	PUSHJ P,IDPARS			; GET AN IDENTIFIER
LLEV1:	MOVEI T,ID
	MOVEI TA,LEV1
	PUSHJ P,EQUAL			; TEST FOR EQUALITY
	JRST [	SKIPN LEV1
		JRST LEV1A		;   ID<LEV1 - ADD ID BEFORE BLOCK
		JRST ENDXRF]		;		OR END OF XREF
	JRST [	MOVE 4,LKSM
		JRST EQUL1]		;   ID=LEV1 - STILL ON SAME ID
	POP P,PT			;   ID>LEV1 - NEW ID GET LEVEL 1 PTR
LEV1C:	HRRZ 6,(PT)
	JUMPE 6,LEV1A			; END OF LIST - ADD NEW IDENTIFIER
	MOVEI TA,2(6)			; GET POINTER TO NEXT IDENTIFIER
	PUSHJ P,EQUAL
	JRST LEV1A			; ADD NEW ID BEFORE THIS BLOCK
	JRST [	HRRZ PT,(PT)
		JRST LEV1B]		; IDENTIFIER FOUND IN LIST
	HRRZ PT,(PT)
	JRST LEV1C			; CHECK NEXT ELEMENT OF LIST

LEV1B:	PUSH P,PT			; IDENTIFIER FOUND, SAVE LEVEL 1 PTR
	HLRZ PT,1(PT)			; GO DOWN ONE LEVEL
	HRRZ 6,(PT)			; AND FIND END OF LIST OF FILES
	JUMPE 6,LEV2A
	MOVEI PT,(6)
	JRST .-3

LEV2A:	MOVE 4,LKSM			; AND BRANCH TO LINK FILE BLOCK
	JRST LEV2B			; AT SAME LEVEL

LEV1A:	PUSHJ P,CREBLK			; CREATE A NEW BLOCK - ID PNTR IN T
	PUSH P,NEW			; SAVE NEW LEVEL 1 POINTER
	MOVE 1,(PT)			; LINK NEW BLOCK AT SAME LEVEL
LKSM:	HRRM NEW,(PT)
	HRLM PT,(NEW)
	HRRM 1,(NEW)
	HRLM NEW,(1)
	MOVEI PT,(NEW)
	MOVE 4,[HRLM NEW,1(PT)]		; LINK FILE BLOCK AT NEXT LEVEL
LEV2B:	MOVEI T,NAME			; CREATE BLOCK FOR FILE NAME
	PUSHJ P,CREBLK
	XCT 4				; LINK AT  LEVEL 2
	MOVEI PT,(NEW)
	MOVE 1,[XWD ID,LEV1]		; SAVE CURRENT LEVEL 1 IDENTIFIER
	BLT 1,LEV1+7
; KEEP ON BUILDING STRUCTURE

	CAIG CONV,"9"			; IS NEXT ELEMENT A NUMBER?
	CAIGE CONV,"0"
	JRST LEV3A			; NO 
	MOVEI 1,1(FR)			; YES - SAVE CURRENT LEVEL 3 POINTER
	PUSH P,1			; SAVE TO-BE-CREATED LEVEL 3 PNTR
	JRST NUL

LEV3A:	MOVE 4,[HRLM NEW,1(PT)]		; LINK BLOCK AT NEXT LEVEL
EQUL1:	PUSHJ P,IDPARS			; GET BLOCK NAME
	MOVEI T,ID
	PUSHJ P,CREBLK			; CREATE A BLOCK FOR IT
	XCT 4				; AND LINK IT AT LEVEL 3
	MOVEI PT,(NEW)
	PUSH P,PT			; SAVE CURRENT LEVEL 3 POINTER
NUL:	AOBJN FR,.+2			; CREATE A BLOCK FOR THE LINE NUMBERS
	PUSHJ P,GETCOR
	HRLM FR,1(PT)			; AND LINK AT NEXT LEVEL (3 OR 4)
	SETZM (FR)
	AOBJN FR,.+2
	PUSHJ P,GETCOR
	HRRZI PT,(FR)
	SETZM (PT)
	SETZM T
C2:	PUSHJ P,IDPARS			; GET NEXT NUMBER
	SKIPE ID
	JRST ENDLEV 			; IDENTIFIER 
	MOVE TA,NUMB
	CAIL TA,77777
	JRST ENDXRF			; FUNNY NUMBER - EOF 
	CAIN CONV,"#"
	MOVNS TA			; NEGATE LINE NUMBER IF DEFINITION
	JUMPN T,.+4
	AOBJN FR,.+2
	PUSHJ P,GETCOR
	AOS (PT)			; INCREMENT WORD COUNT
	XCT CTAB(T)
	TRC T,1
	JRST C2

CTAB:	HRLZM TA,(FR)
	HRRM TA,(FR)

ENDLEV:	POP P,PT			; RESTORE LEVEL THREE POINTER
	JRST LLEV1			; RETURN TO START NEXT LINE

ENDXRF:	MOVE P,[IOWD PLEN,PDL]		;FLUSH ENTIRE STACK
	JRST LOOP			;RETURN FOR NEXT FILE
; END OF STRUCTURE BUILDING - NOW WE OUTPUT IT

N←15;	FIELD WIDTH
M←14;	FIELD START
CNT←10;	LINE CHAR COUNT
LCT←7;	LINE NUMBER COUNT
LEN←6;	MAXIMUM LINE LENGTH

ENDFIL:	CLOSE 1,			;RELEASE LAST INPUT FILE
	SKIPN 1,OUTPNT
	MOVEI 1,DEFOUT
	ENTER 1,(1)			;CREATE OUTPUT FILE
	JRST [	OUTSTR CRLF
		OUTSTR [ASCIZ .COULD NOT ENTER OUTPUT FILE.]
		CALLI 12]
	MOVEI BUFRS
	MOVEM JOBFF
	OUTBUF 1,NBUF
	SKIPN PT,STRUCT
	JRST DONE
	MOVEI LEN,=120
	SKIPE SHORT
	MOVEI LEN,=70			;MAXIMUM LINE LENGTH
	SETZM M				; INIT FIELD START
	MOVEI N,=10			; AND FIELD WIDTH
	MOVE [PUSHJ P,GLBCHK]		;INIT GLOBAL TEST
	SKIPN GLBAL
	MOVE [SKIPA]			; IF REQUESTED
	SKIPE LOCAL
	MOVE [PUSHJ P,LOCCHK]		; INIT LOCAL TEST
	MOVEM TEST#
	SETZM CNT			; INIT CHARACTER COUNT
	PUSHJ P,OUTLPT			;CALL OUTPUT ROUTINE
DONE:	RELEASE 1,			;END OF LISTING
GCLOOP:	MOVE 1,SVJOB			;SET CORE BACK TO INITIAL VALUE
	MOVEM 1,JOBFF
	CALLI 1,11
	HALT
	JRST GCREF
; RECURSIVE OUTPUT ROUTINE
; EACH CALL OUTPUTS A LIST AT ONE LEVEL

OUTLPT:	XCT TEST		; DO SELECTION TEST
	JRST NXTBLK		; FAILED - GET NEXT BLOCK
	MOVEI CONV," "		;FILL IN BLANKS TO COLUMN M
	CAIL CNT,(M)		;OTHERWISE THIS IS AN ID BLOCK
	JRST OL1
	PUSHJ P,PCHAR
	JRST .-3

OL1:	HLRZ 5,1(PT)		;GET POINTER TO NEXT LOWER LEVEL
	JUMPE 5,LINOUT		;NONE- THIS IS A LINE NUMBER BLOCK
	MOVEI T,2(PT)		;POINTER TO IDENTIFIER NAME
	MOVEI TA,-1(N)		;LEAVE AT LEAST ONE BLANK AFTER NAME
	PUSHJ P,OUTID		;PUT IT IN THE LINE
	PUSH P,TEST		;STACK PARAMATERS FOR RECURSION
	PUSH P,M
	PUSH P,N
	PUSH P,PT
	MOVE [SKIPA]
	MOVEM TEST
	ADDI M,(N)		;SET UP FOR NEXT LEVEL
	MOVEI N,=8
	MOVEI PT,(5)
	PUSHJ P,OUTLPT		;AND CALL AGAIN FOR NEXT LEVEL
	POP P,PT		;ALL LOWER LEVELS DONE, RESTORE
	POP P,N
	POP P,M
	POP P,TEST
NXTBLK:	HRRZ PT,(PT)		;GET NEXT BLOCK ON THIS LEVEL
	JUMPN PT,OUTLPT		;AND RETURN TO PROCESS
	POPJ P,			;IF ZERO, WE ARE DONE AT THIS LEVEL

LINOUT:	HRRZ LCT,1(PT)		;THIS IS A LINE NUMBER BLOCK-GET WORD COUNT
	PUSH P,PT		;SAVE POINTER
	MOVEI PT,1(PT)		;POINT AT FIRST WORD-1 OF LINE NUMBER
	SETZM 3			;INIT HALF WORD
OL3:	JUMPN 3,.+3
	AOS PT			;INDEX TO NEXT WORD IF READY FOR LEFT HALF
	SOJL LCT,OL4		;DONE
	XCT LOAD(3)		;LOAD PROPER HALF WORD
	TRC 3,1			;SWITCH HALVES
	JUMPE 4,OL4		;IF ZERO, DONE
	MOVEI 1,(CNT)		;COMPUTE CHAR COUNT AT END OF OUTPUT
	ADDI 1,(N)
	CAIG 1,(LEN)
	JRST OL2
	MOVEI CONV,15		;OUTPUT CRLF
	PUSHJ P,PCHAR
	MOVEI CONV,12
	PUSHJ P,PCHAR
	SETZM CNT		;CLEAR LINE COUNT
	MOVEI CONV," "		;AND SPACE TO PROPER COLUMN
	CAIL CNT,(M)
	JRST OL2
	PUSHJ P,PCHAR
	JRST .-3

LOAD:	HLRE 4,(PT)
	HRRE 4,(PT)

OL2:	MOVE CONV,4
	PUSHJ P,CONVRT		;OUTPUT LINE NUMBER
	JRST OL3		;RETURN FOR NEXT LINE NUMBER

OL4:	POP P,PT		;RESTORE POINTER
	MOVEI CONV,15		;END OF LINE NUMBER - OUTPUT CRLF
	PUSHJ P,PCHAR
	MOVEI CONV,12
	PUSHJ P,PCHAR
	SETZM CNT
	JRST NXTBLK		;RETURN FOR NEXT BLOCK ON THIS LEVEL

;IDENTIFIER OUTPUT ROUTINE
;POINTER TO COUNT IN T
;MAXIMUM COUNT IN TA
;OUTPUTS MINIMUM OF TWO COUNTS TO LPT
;USES AC 1

OUTID:	CAML TA,(T)
	MOVE TA,(T)		;GET SMALLER COUNT
	MOVE 1,[POINT 7,0]	;SET UP BYTE POINTER
	HRRI 1,1(T)
	ILDB CONV,1
	PUSHJ P,PCHAR
	SOJG TA,.-2
	POPJ P,
; GET ONE PART OF FILE SPECS
; SIXBIT PUT INTO SNAM
; ASCII ADDED TO NAME THROUGH POINTER IN 2
; EXPECT POINTER TO INPUT BUFFER IN 1
; LEAVES BREAK CHARACTER IN 4
; SKIPS BLANKS

GETPAR:	MOVE 3,[POINT 6,SNAM]
	SETZM SNAM
GETCHR:	ILDB 4,1
	CAIN 4," "
	JRST GETCHR
	CAIL 4,"0"
	CAILE 4,"9"
	SKIPA
	JRST .+4
	CAIL 4,"A"
	CAILE 4,"Z"
	POPJ P,
	IDPB 4,2
	MOVEI 4,-40(4)
	IDPB 4,3
	JRST GETCHR

;GET ONE CHARACTER FROM INPUT BUFFER
;RETURN IT IN CONV
;BRANCH TO EOF IF END OF FILE ON DISK SEEN

GCHAR:	SOSG IBUF+2
	IN 1,
	SKIPA
	JRST DSKERR
	ILDB CONV,IBUF+1
	POPJ P,

;PUT ONE CHARACTER IN OUTPUT BUFFER
;IT IS IN CONV

PCHAR:	SOSG OBUF+2
	OUT 1,
	SKIPA
	JRST DERR
	IDPB CONV,OBUF+1
	AOS CNT				;INDEX CHAR COUNT
	POPJ P,

DSKERR:	STATZ 1,20000
	JRST [	SETOM CONV		;EOF-RETURN NEG. CHAR
		POPJ P,]
DERR:	OUTSTR CRLF
	OUTSTR [ASCIZ .DISK ERROR.]
	CALLI 12
; MAGIC DECIMAL CONVERSION ROUTINE 
; N DIGIT OUTPUT WITH LEAD ZEROS SUPPRESSED
; # AFTER NUMBER IF IT WAS NEGATIVE
; NUMBER IN CONV ON ENTRY
; WILL NOT PRINT ZERO !!
; USES AC T AND TA AND 1


CONVRT:	MOVM T,CONV
	SKIPGE CONV
	JRST	[PUSH P,["#"]
		JRST .+2]
	PUSH P,[" "]
	MOVEI 1,-1(N)		;FINAL CHAR COUNTS TOO
	SETZM SUP#
	PUSHJ P,CONV1
	POP P,CONV
	PUSHJ P,PCHAR
	POPJ P,

CONV1:	JUMPE T,[MOVEI CONV," "	;RECURSIVE DECIMAL OUTPUT ROUTINE
		PUSHJ P,PCHAR	;SUPPRESS LEAD ZEROS
		SOJG 1,$.-1
		POPJ P,]
	IDIVI T,=10
	MOVEI TA,60(TA)		;CONVERT DIGIT TO STRING
CONV2:	HRLM TA,(P)		;STACK CHARACTER FOR OUTPUT
	SOJLE 1,.+2
	PUSHJ P,CONV1
	HLRZ CONV,(P)
	JRST PCHAR

; CORE GETTING ROUTINE AND ERROR OUTPUT
; UPDATES FR
; USES AC 1

GETCOR:	MOVE 1,JOBREL
	ADDI 1,2000
	CALLI 1,11
	JRST NOCORE
	HRLI FR,-2000
	POPJ P,

NOCORE:	OUTSTR CRLF
	OUTSTR [ASCIZ .NO FREE CORE.]
	CALLI 12
; STRING EQUALITY TEST
; FIRST STRING POINTER IN T
; SECOND IN TA
; RETURNS IF T<TA
; SKIPS 1 IF T=TA
; SKIPS 2 IF T>TA
; USES ACS 1-5
; DOES NOT ALTER T AND TA

EQUAL:	MOVE 1,(T)		;GET CHARACTER COUNTS FOR STRINGS
	MOVE 3,(TA)
	MOVE 2,[POINT 7,0]	;SET UP BYTE POINTERS TO STRINGS
	MOVE 4,2
	HRRI 2,1(T)
	HRRI 4,1(TA)
	SETZM 5
	SETZM 6
ELOOP:	SOJL 1,E1		;TEST COUNTS FOR END OF STRING
	SOJL 3,E2		;TEST BEFORE COMPARE IN CASE OF NULL STRING
	ILDB 5,2		;GET NEXT PAIR OF CHARACTER
	ILDB 6,4
	CAIGE 5,(6)
	POPJ P,			;COMPARE LOW - T<TA
	CAIG 5,(6)
	JRST ELOOP		;COMPARE EQUAL - TEST NEXT PAIR OF CHARS
	JRST GREAT		;COMPARE GREATER - T>TA

E1:	SOS 3			;END OF STRING 1 - ALIGN STRING 2
E2:	CAMGE 1,3		;END OF STRING 2 - 1 ALREADY ALIGNED
	POPJ P,			;STRING 1 SHORTEST
	CAME 1,3
GREAT:	AOS (P)			;STRING 2 SHORTEST
	AOS (P)			;STRINGS OF EQUAL LENGTH
	POPJ P,

;TEST FOR GLOBAL (OR LOCAL) IDENTIFIER (ON LEVEL 1 ONLY)
;SKIPS IF GLOBAL (OR LOCAL)
;USES AC 1

GLBCHK:	HLRZ 1,1(PT)		;GET LIST OF FILE NAMES
	HRRZ 1,(1)
	SKIPE 1
	AOS (P)			; GLOBAL IF MORE THAN ONE
	POPJ P,

LOCCHK:	HLRZ 1,1(PT)		;GET LIST OF FILE NAMES
	HRRZ 1,(1)
	SKIPN 1
	AOS (P)			; LOCAL IF ONLY ONE
	POPJ P,
; CREATE A NEW IDENTIFIER BLOCK
; POINTER TO IDENTIFIER IN T, WHICH IS DESTROYED
; LEAVES POINTER TO BLOCK IN NEW
; USES AC 1-3

CREBLK:	AOBJN FR,.+2			;GET FIRST WORD
	PUSHJ P,GETCOR
	MOVEI NEW,(FR)			;SAVE POINTER
	SETZM (NEW)			;CLEAR BLOCK POINTERS
	AOBJN FR,.+2			;GET SECOND WORD
	PUSHJ P,GETCOR
	MOVE 2,(T)			;GET CHARACTER COUNT
	ADDI 2,5			;FOR COUNT WORD
	IDIVI 2,5
	SKIPE 3
	ADDI 2,1			;WORD COUNT FOR IDENTIFIER
	MOVEM 2,(FR)
	AOBJN FR,.+2			;STORE CHAR COUNT AND ID
	PUSHJ P,GETCOR
	MOVE 3,(T)
	MOVEM 3,(FR)
	AOS T
	SOJG 2,.-5
	POPJ P,

; TEST FILE SPECIFIED TO MAKE SURE IT EXISTS

LOOKFL:	HRLI 3,-3(FR)
	HRRI 3,LBLK
	BLT 3,LBLK+3
	LOOKUP 1,LBLK
	JRST	[SETOM ERROR		; FILE DOES NOT EXIST - SET FLAG
		OUTSTR CRLF
		OUTSTR [ASCIZ .NO SUCH FILE - .]
		SETZM 6			; AND TELL HIM NOW RATHER THAN
		IDPB 6,2		; AFTER TEN MINUTES OF PROCESSING
		OUTSTR NAME		; THE PREVIOUS FILES
		POPJ P,]
	POPJ P,

LBLK:	BLOCK 4
; THIS IS THE MAGIC 6-STATE, TABLE DRIVEN, INPUT PARSER
; STATE IS IN ST
; OUTPUT IS IN ID, IF IDENTIFIER, NUMB IF NUMBER
; RETURNS WITH CONV CONTAINING BREAK CHAR, 0 IF IDENT. WAS TOO LONG
; IF ID IS ZERO, RETURNING NUMBER; OTHERWISE, ID IS COUNT WITH IDENT.
;   STARTING IN ID+1
; USES AC 1

IDPARS:	MOVEI ST,2			;INIT TO PARSE IDENTIFIERS
PARSE:	SKIPN CONV,SVBRK#		; USE BREAK CHAR IF SAVED
GET:	HALT				; CALLING PROGRAM INITS INPUT
	SETZM SVBRK			; BREAK BAD HERE
	JUMPL CONV,DSKEOF		; THIS IS DISK EOF
	ANDI CONV,177			; DISPATCH ON CHARACTER
	JRST @(CONV)TAB

; BRANCHES FROM INPUT SCANNER TABLE

GOODTS:	POP P,(P)		;FLUSH RETURN
	MOVE [XWD LFATB,T3+2]	;SET CODE TO SWITCH INPUT AT NEXT LF
	BLT T3+5
	SETZM SVBRK
	JRST TSTOK		;AND PASS TEST

FAIL2:	POP P,(P)		;FLUSH RETURN
	JRST P2			;WE ARE AT NEXT PAGE

BRKA:	SKIPN CCNT		;NULL LINE ILLEGAL AS FIRST LINE
	JRST FAILTS
BRK:	AOS CCNT		;INDEX CHARACTER COUNT
	SKIPL ID
	JRST GET		;RETURN ONLY IF IDENTIFIER FOUND
	MOVEI =10*5+1		;COMPUTE CHAR COUNT
	ADDM ID
POPLAB:	POPJ P,			;ALSO USED FOR IMMEDIATE RETURNS

PROC:	SKIPN ID		;PROCESS IDENTIFIER IN TEST MODE
	JRST [SKIPE FID
	      JRST $.+3
	      SKIPE CCNT	; FIRST
	      JRST FAILTS	; IDENTIFIER SHOULD START AT FIRST CHAR
	      AOS FID
	      MOVNI =10*5+1	;  START OF ID IF NO COUNT
	      MOVEM ID		;   STORE - MAX COUNT TO STOP LOOP
	      MOVE 1,[POINT 7,ID+1]
	      JRST .+1]
	AOSL ID			;INCREMENT COUNT
	JRST BRK		;RETURN IF IDENT. TOO LONG
	IDPB CONV,1		;STORE NEXT CHAR
	JRST GET
; MORE BRANCHES FOR INPUT SCANNER

BADCHR:	OUTSTR CRLF		;ILLEGAL CHARACTER FOUND
	OUTSTR [ASCIZ .ILLEGAL CHARACTER:.]
	OUTCHR CONV
	OUTSTR [ASCIZ . FOUND IN FILE .]
	OUTSTR NAME+1
	JRST ENDXRF		;START NEXT FILE

STBRK:	MOVEI ST,5		;START BREAK SCAN
	JRST GET

BRKSAV:	MOVEM CONV,SVBRK	;BREAK, SAVE, AND RETURN
BRKRET:	SKIPL ID
	POPJ P,
	MOVEI =10*5+1		;BREAK AND RETURN
	ADDM ID			;FIXUP ID COUNT IF IDENTIFIER
	POPJ P,

STNUM:	SETZM ID		;START PROCESSING NUMBER
	MOVEI ST,4
	SUBI CONV,60
	MOVEM CONV,NUMB
	JRST GET

ADDNUM:	MOVE 1,NUMB		;ADD TO NUMBER
	IMULI 1,=10
	SUBI CONV,60
	ADDI 1,(CONV)
	MOVEM 1,NUMB
	JRST GET

STID:	MOVNI =10*5+1		;START IDENTIFIER PROCESSING
	MOVEM ID
	MOVE 1,[POINT 7,ID+1]
	MOVEI ST,3
ADDID:	AOSL ID			;ADD TO IDENTIFIER
	JRST [SETZM CONV	;ID OVERFLOWED
	      JRST BRK]
	IDPB CONV,1
	JRST GET

SETGET:	MOVE P10		;FIXUP INPUT AND LINE FEED DISPATCH
	MOVEM GET
	SETZM SVBRK
	MOVE [XWD LFTAB,T3+2]
	BLT T3+5
	JRST @T3(ST)

ZCHAR:	CAILE ST,2		;ZERO CHARACTER FOUND - DISK EOF
	OUTSTR [ASCIZ .NOT A CREF FILE !!!.]
	JRST ENDXRF
; STILL MORE BRANCHES

FAILTS:	POP P,(P)		;FLUSH RETURN
	MOVE P10		;SET INPUT TO READ FROM DISK
	MOVEM GET
	JRST TSTFAL		;AND FAIL TEST

DSKEOF:	CAILE ST,2
	JRST BRKSAV		; 3-5 BREAK, SAVE, AND RETURN
	JRST ZCHAR		; 0-2 TERMINATE THIS FILE
; PRIMARY TABLE FOR INPUT SCANNER

TAB:	20,,T6				;NULL CHAR
	REPEAT =8,{ST+20,,T1}
	ST+20,,T2			;TAB
	ST+20,,T3			;LINE FEED
 	ST+20,,T1
	ST+20,,T4			;FORM FEED
	ST+20,,T5			;CARRIAGE RETURN
	REPEAT =18,{ST+20,,T1}
	ST+20,,T2			;SPACE
	REPEAT 2,{ST+20,,T1}
	ST+20,,T7			;#
	ST+20,,T10			;$
	REPEAT =9,{ST+20,,T1}
	ST+20,,T10			;.
	ST+20,,T1
	REPEAT =10,{ST+20,,T9}		;DIGITS
	REPEAT 7,{ST+20,,T1}
	REPEAT =26,{ST+20,,T10}		;CAPITAL LETTERS
	REPEAT 6,{ST+20,,T1}
	REPEAT =26,{ST+20,,T10}		;SMALL LETTERS
	REPEAT 5,{ST+20,,T1}

; SECONDARY TABLES FOR SCANNER
; STATES ARE:
;	0	SCANNING FIRST LINE TESTING FOR CORRECT PAGE
;	1	SCANNING FOR FORM FEED
;	2	SCANNING FOR IDENTIFIER OR NUMBER
;	3	SCANNING IDENTIFIER
;	4	SCANNING NUMBER
;	5	SCANNING FOR BREAK CHARACTERS

;	INVALID CHARACTERS

T1:	FAILTS		;0-FAIL TEST
	GET		;1-IGNORE
	REPEAT 4,{BADCHR} ;2-5 ILLEGAL

;	TAB AND SPACE

T2:	BRK		;0-BREAK
	GET		;1-IGNORE
	GET		;2-IGNORE
	STBRK		;3-START BREAK
	STBRK		;4-START BREAK
	GET		;5-IGNORE

;	NULL CHAR - DISK EOF OR END OF BUFFER IN ALL STATES

T6:	GET		;IGNORE
; MORE SECONDARY TABLES
;	LINE FEED

T3:	GOODTS		;0-END OF TEST
	GET		;1-IGNORE
	GET		;2-IGNORE
	STBRK		;3-START BREAK
	STBRK		;4-START BREAK
	GET		;5-IGNORE

;	FORM FEED

T4:	FAIL2		;0-FAIL TEST
	POPLAB		;1-FF FOUND
	GET		;2-IGNORE
	STBRK		;3-START BREAK
	STBRK		;4-START BREAK
	GET		;5-IGNORE

;	CARRIAGE RETURN

T5:	BRKA		;0-BREAK
	REPEAT 5,{GET}	;1-5 IGNORE

;	#

T7:	BRK		;0-BREAK
	GET		;1-IGNORE
	BADCHR		;2-ILLEGAL
	BADCHR		;3-ILLEGAL
	BRKRET		;4-BREAK AND RETURN
	BADCHR		;5-ILLEGAL

;	DIGITS

T9:	BRK		;0-BREAK
	GET		;1-IGNORE
	STNUM		;2-START PROCESSING NUMBER
	ADDID		;3-ADD TO IDENTIFIER
	ADDNUM		;4-ADD TO NUMBER
	BRKSAV		;5-BREAK, RETURN, AND SAVE

;	PERIOD AND LETTERS

T10:	PROC		;0-PROCESS IDENTIFIER
	GET		;1-IGNORE
	STID		;2-START PROCESSING IDENTIFIER
	ADDID		;3-ADD TO IDENTIFIER
	BADCHR		;4-ILLEGAL
	BRKSAV		;5-BREAK, RETURN, AND SAVE
; FINISH WITH SOME VARIABLES

PDL:	BLOCK PLEN		;PUSH DOWN LIST
DEFOUT:	SIXBIT .GCREF.		;DEFAULT OUTPUT FILE
	SIXBIT .LST.
	0
	0
COMPNT:	POINT 7,COMBUF
COMBUF:	BLOCK =30		;COMMAND BUFFER
SNAM:	BLOCK =5		;SIXBIT NAME
NAME:	BLOCK =5		;ASCIZ NAME (OF DISK FILE)
DEFEXT:	SIXBIT .LST.		;DEFAULT EXTENTION
DEFPPN:	0			;DEFAULT PPN
OBUF:	BLOCK 3
IBUF:	BLOCK 3
BUFRS:	BLOCK NBUF*204		;HERE ARE OUR BUFFERS
CRLF:	ASCIZ .
.
ID:	BLOCK =10		;CURRENT IDENTIFIER
NUMB:	0			;CURRENT NUMBER
LEV1:	BLOCK =10		;TOP LEVEL IDENTIFIER
SHORT:	0			;NON-ZERO IF SHORT LISTING WANTED
LOCAL:	0			;NON-ZERO IF ONLY LOCALS WANTED
GLBAL:	0			;NON-ZERO IF ONLY GLOBALS WANTED
INPNT:	0			;POINTS TO LIST OF INPUT FILES
STRUCT:	0			;POINTS TO START OF DATA STRUCTURE
ERROR:	0			;NON-ZERO FOR COMMAND ERROR
OUTPNT:	0			;POINTS TO OUTPUT FILE NAME
CCNT:	0			;CHARACTER COUNT FOR PAGE TESTING
FID:	0			;NUMBER OF IDENTIFIERS SEE SO FAR THIS LINE
LFATB:	REPEAT 4,{JRST SETGET}
LFTAB:	GET
	STBRK
	STBRK
	GET

	LIT			; FORCE ALLOCATION OF LITERALS AND VARIABLES
	VAR
FREE:				;HERE IS OUR FREE STORAGE
				; NO CODE BEYOND THIS ADDESS
	END GCREF-2